logo

This script downloads and maps recent eBird data from a Christmas Bird Count circle. It is useful for helping participants to “scout” birds that may occur in their circle/section. This example is run for the West Hennepin 2023 count circle, but it could easily be adapted to other counts.

Setup

Load packages

# Load libraries
library(rebird)
library(dplyr)
library(tidyr)
library(here)
library(ggplot2)
library(sf)
library(ggmap)
library(mapview)
library(DT)

Set parameters

# Name for run (create output directory)
tag <- "West_Hennepin_20231224"

# Define the center coordinates and circle radius
center_lat <- 45.09468
center_long <- -93.63574
center <- c(center_long, center_lat)
radius_km <- 12.07

# How many days back to pull data?
time_days <- 30
# today <- Sys.Date()
today <- "2023-12-24"

Get recent eBird data

# Create a circular buffer using the center and radius
circle <- st_buffer(st_sfc(st_point(center), crs = 4326), dist = radius_km * 1000)
bbox <- st_bbox(circle)

recent_sigtings_file <- here("Projects", "CBC_Scouting", tag, "CBC_sightings_recent.RDS")

if (file.exists(recent_sigtings_file)) {
  CBC_sightings_recent <- readRDS(recent_sigtings_file)
} else {
  # Get recent species
  sp_list <- ebirdgeo(lat = center_lat, lng = center_long, dist = radius_km, back = time_days) %>%
    pull(speciesCode)

  CBC_sightings_recent_raw <- mapply(ebirdgeo, species = sp_list, lat = center_lat, lng = center_long, dist = radius_km, back = time_days)

  # Combine in one dataframe
  CBC_sightings_recent <- bind_rows(
    lapply(CBC_sightings_recent_raw, function(df) {
      if ("exoticCategory" %in% colnames(df)) {
        # If "exoticCategory" column is present, keep it, else create it with NA values
        df <- df %>%
          mutate(exoticCategory = ifelse(!("exoticCategory" %in% colnames(df)), NA, as.character(exoticCategory)))
      } else {
        # If "exoticCategory" column is not present, create it with NA values
        df$exoticCategory <- NA_character_
      }
      return(df)
    })
  )

  saveRDS(CBC_sightings_recent, recent_sigtings_file)
}

Map observations

# Map will bin observations into which week they were observed.
# First project and format date field
CBC_sightings_recent <- CBC_sightings_recent %>%
  st_as_sf(coords = c("lng", "lat"), crs = 4326) %>%
  mutate(Date = as.Date(obsDt))

# Bin dates (approximate number of weeks)
num_bins <- round(time_days / 7, 0)

# Calculate bin edges, extending the range slightly beyond the minimum and maximum dates
min_date <- min(CBC_sightings_recent$Date) - 1
max_date <- max(CBC_sightings_recent$Date)
bin_edges <- seq(min_date, max_date, length.out = num_bins + 1)

# Bin the Date variable
CBC_sightings_recent$DateBin <- cut(CBC_sightings_recent$Date, breaks = bin_edges, labels = FALSE, right = TRUE)

# Get a map tile from a map service (e.g., Stadia Alidade). This ill throw an error if API key isn't in .Renviron.
map_tile <- get_stadiamap(bbox = c(bbox[[1]], bbox[[2]], bbox[[3]], bbox[[4]]), zoom = 11, maptype = "alidade_smooth")

# Generate map
p <- ggmap(map_tile) +
  geom_sf(data = circle, fill = "transparent", color = "grey20", size = 1, inherit.aes = FALSE) +
  geom_sf(data = st_jitter(CBC_sightings_recent), size = 1.5, alpha = .9, aes(color = as.factor(DateBin)), inherit.aes = FALSE) +
  scale_color_manual(name = "Week starting:", values = rev(viridisLite::inferno(num_bins)), labels = format(bin_edges, "%Y-%m-%d")) +
  ggthemes::theme_map() +
  theme(
    legend.position = "top",
    legend.justification = "right",
    legend.background = element_rect(
      fill = "grey90",
      linewidth = 0.25, linetype = "solid",
      colour = "grey40"
    ),
    legend.key = element_rect(fill = "grey90"),
    plot.title = element_text(size = 8, face = "bold"),
    plot.subtitle = element_text(size = 6, face = "italic"),
    strip.text = element_text(size = 6)
  ) +
  facet_wrap(~comName) +
  labs(
    title = "West Hennepin CBC: recent eBird observations",
    subtitle = paste0("Data from 30 day period ending ", today)
  )

ggsave(plot = p, here("Projects", "CBC_Scouting", tag, paste0(tag, "_recent_ebird_data.pdf")), width = 8.5, height = 11)

p

Generate hotspot summaries

recent_hotspots_sigtings_file <- here("Projects", "CBC_Scouting", tag, "CBC_hotspot_sightings_recent.RDS")
hotspots_file <- here("Projects", "CBC_Scouting", tag, "CBC_hotspots.RDS")

if (file.exists(recent_hotspots_sigtings_file) & file.exists(hotspots_file)) {
  CBC_hotspot_sightings_recent <- readRDS(recent_hotspots_sigtings_file)
  CBC_hotspots <- readRDS(hotspots_file)
} else {
  CBC_hotspots <- rebird::ebirdhotspotlist(lat = center_lat, lng = center_long, dist = radius_km) %>%
    st_as_sf(coords = c("lng", "lat"), crs = 4326)
  saveRDS(CBC_hotspots, hotspots_file)

  mapview(CBC_hotspots, label = "locName")

  CBC_hotspot_sightings_recent <- sapply(CBC_hotspots$locId, ebirdregion, simple = FALSE, back = time_days)

  # Combine in one data frame
  CBC_hotspot_sightings_recent <- bind_rows(
    lapply(CBC_hotspot_sightings_recent, function(df) {
      if ("exoticCategory" %in% colnames(df)) {
        # If "exoticCategory" column is present, keep it, else create it with NA values
        df <- df %>%
          mutate(exoticCategory = ifelse(!("exoticCategory" %in% colnames(df)), NA, as.character(exoticCategory)))
      } else {
        # If "exoticCategory" column is not present, create it with NA values
        df$exoticCategory <- NA_character_
      }
      return(df)
    })
  )

  CBC_hotspot_sightings_recent <- CBC_hotspot_sightings_recent %>%
    replace_na(list(howMany = 1))

  saveRDS(CBC_hotspot_sightings_recent, recent_hotspots_sigtings_file)
}

# Generate table with recent species observed at each hotspot (with date last documented)
species_by_hotspot <- CBC_hotspot_sightings_recent %>%
  mutate(obsDtmd = format(as.Date(obsDt), "%m-%d")) %>%
  pivot_wider(id_cols = comName, names_from = locName, values_from = obsDtmd, values_fn = max) %>%
  left_join(rebird:::tax %>% select(comName, taxonOrder)) %>%
  arrange(taxonOrder) %>%
  select(-taxonOrder)
species_by_hotspot[is.na(species_by_hotspot)] <- ""
species_by_hotspot <- species_by_hotspot %>%
  select(sort(tidyselect::peek_vars())) %>%
  select(comName, everything())

species_by_hotspot %>%
  datatable(
    options = list(pageLength = 25),
    caption = "Hotspots each species has been recently documented in"
  )
write.csv(species_by_hotspot, here("Projects", "CBC_Scouting", tag, "species_by_hotspot_last_seen.csv"))

count_hotspots_by_sp <- CBC_hotspot_sightings_recent %>%
  group_by(comName) %>%
  summarize(
    n_hotspots_observed = length(unique(locName)),
    parks_observed = paste(sort(unique(locName)), collapse = ", ")
  ) %>%
  left_join(rebird:::tax %>% select(comName, taxonOrder)) %>%
  arrange(taxonOrder) %>%
  select(-taxonOrder) %>%
  arrange(desc(n_hotspots_observed))

count_hotspots_by_sp %>%
  datatable(
    options = list(pageLength = 25),
    caption = "Number of hotspots each species has recently been observed in"
  )
write.csv(species_by_hotspot, here("Projects", "CBC_Scouting", tag, "count_hotspots_by_sp_raw.csv"))

# rare sp are those seen in fewer than 30% of hotspots
rare_sp <- count_hotspots_by_sp %>%
  filter(n_hotspots_observed <= nrow(CBC_hotspots) * .3) %>%
  pull(comName)

# unique sp are those seen in only 1 hotspot
unique_sp <- count_hotspots_by_sp %>%
  filter(n_hotspots_observed == 1) %>%
  pull(comName)

count_sp_by_hotspot <- CBC_hotspot_sightings_recent %>%
  group_by(locName) %>%
  summarize(
    n_sp = length(unique(comName)),
    n_rare_sp = length(intersect(rare_sp, unique(comName))),
    n_unique_sp = length(intersect(unique_sp, unique(comName))),
    rare_sp = paste(sort(intersect(rare_sp, unique(comName))), collapse = ", "),
    unique_sp = paste(sort(intersect(unique_sp, unique(comName))), collapse = ", ")
  ) %>%
  arrange(desc(n_sp))

write.csv(species_by_hotspot, here("Projects", "CBC_Scouting", tag, "count_sp_by_hotspot_raw.csv"))

count_sp_by_hotspot %>%
  datatable(
    options = list(pageLength = 25),
    caption = "Hotspots with total number of recently species and rare/unique species. Rare species are those seen in <=30% of hotspots."
  )

Session info

sessionInfo()
## R version 4.2.2 (2022-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 22621)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United States.utf8  LC_CTYPE=English_United States.utf8   
## [3] LC_MONETARY=English_United States.utf8 LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.utf8    
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] ggmap_4.0.0             rebird_1.3.0            CoordinateCleaner_3.0.1
##  [4] rgbif_3.7.8             MASS_7.3-58.1           viridis_0.6.4          
##  [7] viridisLite_0.4.2       effects_4.2-2           carData_3.0-5          
## [10] knitr_1.45              snakecase_0.11.1        DHARMa_0.4.6           
## [13] glmmTMB_1.1.8           performance_0.10.8      insight_0.19.7         
## [16] gridExtra_2.3           jagsUI_1.5.2            png_0.1-8              
## [19] transformr_0.1.3        gifski_1.12.0-2         gganimate_1.0.8        
## [22] ggspatial_1.1.9         ggrepel_0.9.4           RVAideMemoire_0.9-83-7 
## [25] pairwiseAdonis_0.4.1    cluster_2.1.4           goeveg_0.6.5           
## [28] vegan_2.6-4             lattice_0.20-45         permute_0.9-7          
## [31] mapview_2.11.2          ggtext_0.1.2            ratelimitr_0.4.1       
## [34] rvest_1.0.3             trelliscopejs_0.2.6     plotly_4.10.3          
## [37] auk_0.7.0               readxl_1.4.3            kableExtra_1.3.4       
## [40] ggthemes_5.0.0          forcats_1.0.0           stringr_1.5.1          
## [43] purrr_1.0.2             readr_2.1.4             tidyr_1.3.0            
## [46] tibble_3.2.1            ggplot2_3.4.4           tidyverse_2.0.0        
## [49] lubridate_1.9.3         dplyr_1.1.4             DT_0.31                
## [52] sf_1.0-14               rgdal_1.6-4             sp_2.1-2               
## [55] RODBC_1.3-23            here_1.0.1             
## 
## loaded via a namespace (and not attached):
##   [1] estimability_1.4.1      coda_0.19-4             ragg_1.2.6             
##   [4] bit64_4.0.5             multcomp_1.4-25         data.table_1.14.8      
##   [7] rpart_4.1.19            doParallel_1.0.17       generics_0.1.3         
##  [10] leaflet_2.2.1           terra_1.7-55            cowplot_1.1.1          
##  [13] TH.data_1.1-2           commonmark_1.9.0        proxy_0.4-27           
##  [16] bit_4.0.5               tzdb_0.4.0              webshot_0.5.5          
##  [19] xml2_1.3.5              httpuv_1.6.12           wk_0.9.1               
##  [22] assertthat_0.2.1        oai_0.4.0               xfun_0.41              
##  [25] hms_1.1.3               jquerylib_0.1.4         satellite_1.0.4        
##  [28] evaluate_0.23           promises_1.2.1          fansi_1.0.5            
##  [31] progress_1.2.3          DBI_1.1.3               htmlwidgets_1.6.4      
##  [34] stats4_4.2.2            ellipsis_0.3.2          crosstalk_1.2.1        
##  [37] backports_1.4.1         survey_4.2-1            markdown_1.12          
##  [40] epuRate_0.1             vctrs_0.6.5             geosphere_1.5-18       
##  [43] rnaturalearth_0.3.4     cachem_1.0.8            withr_2.5.2            
##  [46] triebeard_0.4.1         ggh4x_0.2.6             checkmate_2.3.0        
##  [49] vroom_1.6.4             emmeans_1.8.9           prettyunits_1.2.0      
##  [52] mclust_6.0.1            svglite_2.1.2           dotCall64_1.1-1        
##  [55] lazyeval_0.2.2          crayon_1.5.2            leaflet.providers_2.0.0
##  [58] crul_1.4.0              pkgconfig_2.0.3         labeling_0.4.3         
##  [61] units_0.8-5             tweenr_2.0.2            nlme_3.1-160           
##  [64] nnet_7.3-18             rlang_1.1.2             lifecycle_1.0.4        
##  [67] sandwich_3.0-2          httpcode_0.3.0          cellranger_1.1.0       
##  [70] rprojroot_2.0.4         urltools_1.7.3          Matrix_1.6-4           
##  [73] raster_3.6-26           boot_1.3-28             zoo_1.8-12             
##  [76] base64enc_0.1-3         whisker_0.4.1           bitops_1.0-7           
##  [79] gap.datasets_0.0.6      KernSmooth_2.23-20      spam_2.10-0            
##  [82] classInt_0.4-10         s2_1.1.4                brew_1.0-8             
##  [85] jpeg_0.1-10             scales_1.3.0            lpSolve_5.6.19         
##  [88] magrittr_2.0.3          plyr_1.8.9              compiler_4.2.2         
##  [91] lme4_1.1-35.1           cli_3.6.1               pbapply_1.7-2          
##  [94] TMB_1.9.9               htmlTable_2.4.2         Formula_1.2-5          
##  [97] mgcv_1.8-41             tidyselect_1.2.0        stringi_1.8.2          
## [100] textshaping_0.3.7       DistributionUtils_0.6-1 highr_0.10             
## [103] mitools_2.4             yaml_2.3.7              grid_4.2.2             
## [106] sass_0.4.7              tools_4.2.2             timechange_0.2.0       
## [109] rstudioapi_0.15.0       uuid_1.1-1              foreach_1.5.2          
## [112] foreign_0.8-83          rjags_4-15              leafpop_0.1.0          
## [115] farver_2.1.1            digest_0.6.33           shiny_1.8.0            
## [118] qgam_1.3.4              autocogs_0.1.4          Rcpp_1.0.11            
## [121] MCMCvis_0.16.3          gridtext_0.1.5          later_1.3.1            
## [124] httr_1.4.7              Rdpack_2.6              colorspace_2.1-0       
## [127] splines_4.2.2           fields_15.2             systemfonts_1.0.5      
## [130] xtable_1.8-4            jsonlite_1.8.7          nloptr_2.0.3           
## [133] leafem_0.2.3            gap_1.5-3               R6_2.5.1               
## [136] Hmisc_5.1-1             pillar_1.9.0            htmltools_0.5.7        
## [139] mime_0.12               glue_1.6.2              fastmap_1.1.1          
## [142] minqa_1.2.6             class_7.3-20            codetools_0.2-18       
## [145] maps_3.4.1.1            mvtnorm_1.2-4           utf8_1.2.4             
## [148] bslib_0.6.1             numDeriv_2016.8-1.1     curl_5.1.0             
## [151] unmarked_1.3.2          survival_3.4-0          rmarkdown_2.25         
## [154] munsell_0.5.0           e1071_1.7-13            iterators_1.0.14       
## [157] gtable_0.3.4            rbibutils_2.2.16
 




By Sam Safran